CM.make "$/ml-yacc-lib.cm";

use "../Common/Core.sml";		   
use "../Common/bjk.grm.sig";
use "../Common/bjk.lex.sml";
use "../Common/bjk.grm.sml";

(* standard structures of the lexer and parser *)
structure BJKLrVals = 
	BJKLrValsFun(structure Token = LrParser.Token);

structure BJKLex = 
	BJKLexFun(structure Tokens = BJKLrVals.Tokens);
 
structure BJKParserStruct = 
	Join(structure ParserData = BJKLrVals.ParserData
				structure Lex=BJKLex
				structure LrParser=LrParser);
		
(* A structure which exposes a simpler interface through which the parser can be invoked. 
   It also has some utility functions - like a function which breaks nested expressions into a sequence
   of simple expressions. *)   
structure BJKParser = struct	
	(* runs the yacc parser on the specified filename *)			
	fun parse (fileName) =
		let 
			val _ = (BJKLex.UserDeclarations.pos := 0); (* reset line numbering *)
			val _ = (BJKLex.UserDeclarations.StrTbl.clear BJKLex.UserDeclarations.varTable); (* clear the variable table *)
			val _ = (BJKLex.UserDeclarations.varIndex := 0); (* reset the variable index *)
			val _ = (BJKLex.UserDeclarations.varString := ""); (* reset variable mapping string *)
			val inStream = TextIO.openIn fileName;
			val grab : int -> string = fn n => if TextIO.endOfStream inStream then "" else TextIO.inputN (inStream,n);
			val lexer = BJKParserStruct.makeLexer grab;
			val printError = fn (s,i:int,_) => TextIO.output(TextIO.stdOut, "Error, line " ^ (Int.toString i) ^ ", " ^ s ^ "\n");
			val (tree,rem) = BJKParserStruct.parse(10, lexer, printError, ()) ;
			(* handle BJKParserStruct.ParseError => raise BJKError; *)
			(* Close the source program file *)
			val _ = TextIO.closeIn inStream;
		in tree
		end;
						
	(* breaks an assignment command into a sequence of assignment commands which are semantically identical
       in term of effect on the store *)
	fun breakAsgnNestedExpression(c : Core.Cmd,newVar : int) : Core.Cmd =
		let 
			fun bne(c : Core.Cmd) : Core.Cmd = 
				case c of Core.Asgn(i,Core.plus(Core.Zero, e)) => bne(Core.Asgn(i, e))
						| Core.Asgn(i,Core.plus(e, Core.Zero)) => bne(Core.Asgn(i, e))	
						| Core.Asgn(i,Core.plus(e, Core.Var y)) => Core.Seq(bne(Core.Asgn(i,e)),
																			Core.Asgn(i,Core.plus(Core.Var i,Core.Var y)))
						| Core.Asgn(i,Core.plus(Core.Var y, e)) => Core.Seq(bne(Core.Asgn(i,e)),
																				Core.Asgn(i,Core.plus(Core.Var i,Core.Var y)))
						| Core.Asgn(i,Core.times(e, Core.Var y)) => Core.Seq(bne(Core.Asgn(i,e)),
																			 Core.Asgn(i,Core.times(Core.Var i,Core.Var y)))
						| Core.Asgn(i,Core.times(Core.Var y, e)) => Core.Seq(bne(Core.Asgn(i,e)),
																				 Core.Asgn(i,Core.times(Core.Var i,Core.Var y)))
		
						| Core.Asgn(i,Core.times(e1, e2)) => Core.Seq(
																	Core.Seq( bne(Core.Asgn(i,e1)), 
																			  bne(Core.Asgn(i+1,e2))),
																	Core.Asgn(i,Core.times(Core.Var i, Core.Var (i+1))))
						| Core.Asgn(i,Core.plus(e1, e2)) => Core.Seq(
																	Core.Seq( bne(Core.Asgn(i,e1)), 
																			  bne(Core.Asgn(i+1,e2))),
																	Core.Asgn(i,Core.plus(Core.Var i, Core.Var (i+1))))

						| _ => c; 
		in
			case c of Core.Asgn(i,Core.Zero) => c
					| Core.Asgn(i,Core.Var _) => c
					| Core.Asgn(i,Core.times(Core.Zero, _)) => Core.Asgn(i, Core.Zero)
					| Core.Asgn(i,Core.times(_, Core.Zero)) => Core.Asgn(i, Core.Zero)	
					| Core.Asgn(i,Core.plus(Core.Var _, Core.Var _)) => c
					| Core.Asgn(i,Core.times(Core.Var _, Core.Var _)) => c
					| Core.Asgn(i,e) => Core.Seq(bne(Core.Asgn(newVar,e)),Core.Asgn(i,Core.Var newVar))
					| _ => c
		end;

	(* Goes over an AST and breaks all nested assignment commands to a sequence of regular assignment commands. 
	   All other command types remain unchanged. *)
	fun astBreakNestedExpressions(ast) = 
		let
			(* goes over an AST and breaks all nested assignment commands to a sequence of regular assignment commands.
		   'hv' is a variable index greater than all variable indices referenced in any of the handled expressions. *)
			fun breakNestedExpressions(Core.Skip,hv) = Core.Skip
			| breakNestedExpressions(Core.Seq(c1,c2),hv) = Core.Seq(breakNestedExpressions(c1,hv),breakNestedExpressions(c2,hv))
			| breakNestedExpressions(Core.Loop(i,c),hv) = Core.Loop(i,breakNestedExpressions(c,hv))
			| breakNestedExpressions(Core.Choice(c1,c2),hv) = Core.Choice(breakNestedExpressions(c1,hv),breakNestedExpressions(c2,hv))
			| breakNestedExpressions(cmd,hv) = breakAsgnNestedExpression(cmd, hv);
		in
			breakNestedExpressions(ast,1 + Core.highest_var(ast))
		end;
	
	(* a function for printing of the AST *)
	fun print(ast) = TextIO.output(TextIO.stdOut,Core.prt ast);

	(* a function for printing of the variable name to index mapping which was generated by the last call to 'parse' *)	
	fun printParserLastVarMapping() = TextIO.output(TextIO.stdOut, "variable mapping:\n"^(!(BJKLex.UserDeclarations.varString))^"\n");

	(* runs the yacc parser on the specified filename and prints:
			1. The mapping from the original program variable names to variable indices in the AST
			2. The result AST.
			3. The result AST with broken nested expressions (all assignments with nested expressions are broken into a sequence of
			   assignments with simple, non-nested, expressions). *)				
	fun parseAndPrint(filename) : Core.Cmd = 
		let
			val ast = parse(filename);
			val _ = TextIO.output(TextIO.stdOut,"original "^filename^":\n");
			val _ = printParserLastVarMapping();
			val _ = TextIO.output(TextIO.stdOut,Core.prt ast);
			val ast = astBreakNestedExpressions(ast);
			val _ = TextIO.output(TextIO.stdOut,"broken "^filename^":\n");
			val _ = TextIO.output(TextIO.stdOut,Core.prt ast); 
		in		
			ast
		end;
end; (* BJKParserInterface *)